home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / fmu.com / FMU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-14  |  27.0 KB  |  792 lines
  1. program FMU;
  2.  
  3. uses WObjects, WinTypes, WinProcs, Strings;
  4.  
  5. {$R FMU.RES}
  6.  
  7. (*::::::::::::::::::::::::::::Constants::::::::::::::::::::::::::::::::*)
  8.  
  9. const T = 1;
  10.       F = 0;
  11.       cb_Removed = 0;
  12.       cb_Checked = 1;
  13.       cb_Grayed  = 2;
  14.       id_HeightScroll = 114;
  15.       ph_HeightScroll = 155;
  16.       id_WidthScroll  = 127;
  17.       ph_WidthScroll  = 156;
  18.       id_EscScroll    = 139;
  19.       ph_EscScroll    = 157;
  20.       id_OrientScroll = 130;
  21.       ph_OrientScroll = 158;
  22.       id_WeightScroll = 136;
  23.       ph_WeightScroll = 159;
  24.       id_Italicized   = 141;
  25.       id_Underlined   = 142;
  26.       id_StrikeOut    = 143;
  27.       id_CharSet      = 146;
  28.         csid_ANSI     = 101;
  29.         csid_OEM      = 105;
  30.         csid_Symbol   = 110;
  31.         csid_OK       = 111;
  32.         csid_Cancel   = 112;
  33.       id_Output       = 147;
  34.         opid_Char     = 101;
  35.         opid_Default  = 102;
  36.         opid_String   = 103;
  37.         opid_Stroke   = 104;
  38.         opid_OK       = 111;
  39.         opid_Cancel   = 112;
  40.       id_Quality      = 148;
  41.         oqid_Default  = 101;
  42.         oqid_Draft    = 102;
  43.         oqid_Proof    = 103;
  44.         oqid_OK       = 111;
  45.         oqid_Cancel   = 112;
  46.       id_Clipping     = 149;
  47.         cpid_Char     = 101;
  48.         cpid_Default  = 102;
  49.         cpid_Stroke   = 103;
  50.         cpid_OK       = 111;
  51.         cpid_Cancel   = 112;
  52.       id_Pitch        = 150;
  53.         fpid_Default  = 101;
  54.         fpid_Fixed    = 102;
  55.         fpid_Variable = 103;
  56.         fpid_OK       = 111;
  57.         fpid_Cancel   = 112;
  58.       id_Family       = 151;
  59.         ffid_Decorate = 101;
  60.         ffid_DontCare = 102;
  61.         ffid_Modern   = 103;
  62.         ffid_Roman    = 104;
  63.         ffid_Script   = 105;
  64.         ffid_Swiss    = 106;
  65.         ffid_OK       = 111;
  66.         ffid_Cancel   = 112;
  67.       id_Weight       = 152;
  68.         fwid_DontCare = 101;
  69.         fwid_Thin     = 102;
  70.         fwid_XtraLite = 103;
  71.         fwid_Light    = 104;
  72.         fwid_Normal   = 105;
  73.         fwid_Medium   = 106;
  74.         fwid_SemiBold = 107;
  75.         fwid_Bold     = 108;
  76.         fwid_XtraBold = 109;
  77.         fwid_Heavy    = 110;
  78.         fwid_OK       = 111;
  79.         fwid_Cancel   = 112;
  80.       id_EditBox      = 144;
  81.       ph_EditBox      = 154;
  82.       id_FaceName     = 153;
  83.       id_AboutFMU     = 175;
  84.         aid_ReturnFMU = 112;
  85.  
  86.  
  87. (*:::::::::::::::::::::::::::::::Objects:::::::::::::::::::::::::::::::*)
  88.  
  89. type
  90.   PMyDlg = ^TMyDlg;
  91.   TMyDlg = object(TDlgWindow)
  92.     x, y: Integer;  { BaseFontDimensions }
  93.     TextFace: Array[0..20] of char;
  94.     EditBox: TEdit;
  95.     TheFont: HFont;
  96.     HeightScroll: TScrollBar;
  97.     WidthScroll: TScrollBar;
  98.     EscScroll: TScrollBar;
  99.     OrientScroll: TScrollBar;
  100.     WeightScroll: TScrollBar;
  101.     constructor Init(AParent: PWindowsObject; AName: PChar);
  102.     procedure BaseFontDimensions;
  103.     function GetClassName: Pchar; virtual;
  104.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  105.     procedure SetupWindow; virtual;
  106.     procedure DefWndProc(var Msg: TMessage); virtual;
  107.     procedure HeightScroller(var Msg: Tmessage); virtual id_First + id_HeightScroll;
  108.     procedure WidthScroller(var Msg: Tmessage); virtual id_First + id_WidthScroll;
  109.     procedure EscScroller(var Msg: Tmessage); virtual id_First + id_EscScroll;
  110.     procedure OrientScroller(var Msg: Tmessage); virtual id_First + id_OrientScroll;
  111.     procedure WeightScroller(var Msg: Tmessage); virtual id_First + id_WeightScroll;
  112.     procedure Italicized(var Msg: TMessage); virtual id_First + id_Italicized;
  113.     procedure Underlined(var Msg: TMessage); virtual id_First + id_Underlined;
  114.     procedure StrikeOut(var Msg: TMessage); virtual id_First + id_StrikeOut;
  115.     procedure CharSet(var Msg: TMessage); virtual id_First + id_CharSet;
  116.     procedure Output(var Msg: TMessage); virtual id_First + id_Output;
  117.     procedure Quality(var Msg: TMessage); virtual id_First + id_Quality;
  118.     procedure Clipping(var Msg: TMessage); virtual id_First + id_Clipping;
  119.     procedure Pitch(var Msg: TMessage); virtual id_First + id_Pitch;
  120.     procedure Family(var Msg: TMessage); virtual id_First + id_Family;
  121.     procedure Weight(var Msg: TMessage); virtual id_First + id_Weight;
  122.     procedure DoStuff;
  123.     procedure CleanUp;
  124.     destructor Done; virtual;
  125.   end;
  126.  
  127.   TAbout = object(TDialog)
  128.     procedure SetupWindow; virtual;
  129.     procedure OKEnd(var Msg: TMessage); virtual id_First + aid_ReturnFMU;
  130.   end;
  131.  
  132.   TCharSet = object(TDialog)
  133.     OldCharSet: integer;
  134.     procedure SetupWindow; virtual;
  135.     procedure RadioSet(MessageID: integer);
  136.     procedure SetANSI(var Msg: TMessage); virtual id_First + csid_ANSI;
  137.     procedure SetOEM(var Msg: TMessage); virtual id_First + csid_OEM;
  138.     procedure SetSymbol(var Msg: TMessage); virtual id_First + csid_Symbol;
  139.     procedure OKEnd(var Msg: TMessage); virtual id_First + csid_OK;
  140.     procedure CancelEnd(var Msg: TMessage); virtual id_First + csid_Cancel;
  141.   end;
  142.  
  143.   TOutput = object(TDialog)
  144.     OldOutput: integer;
  145.     procedure SetupWindow; virtual;
  146.     procedure RadioSet(MessageID: integer);
  147.     procedure SetChar(var Msg: TMessage); virtual id_first + opid_Char;
  148.     procedure SetDefault(var Msg: TMessage); virtual id_first + opid_Default;
  149.     procedure SetString(var Msg: TMessage); virtual id_first + opid_String;
  150.     procedure SetStroke(var Msg: TMessage); virtual id_first + opid_Stroke;
  151.     procedure OKEnd(var Msg: TMessage); virtual id_First + opid_OK;
  152.     procedure CancelEnd(var Msg: TMessage); virtual id_First + opid_Cancel;
  153.   end;
  154.  
  155.   TQuality = object(TDialog)
  156.     OldQuality: integer;
  157.     procedure SetupWindow; virtual;
  158.     procedure RadioSet(MessageID: integer);
  159.     procedure SetDefault(var Msg: TMessage); virtual id_First + oqid_Default;
  160.     procedure SetDraft(var Msg: TMessage); virtual id_First + oqid_Draft;
  161.     procedure SetProof(var Msg: TMessage); virtual id_First + oqid_Proof;
  162.     procedure OKEnd(var Msg: TMessage); virtual id_First + oqid_OK;
  163.     procedure CancelEnd(var Msg: TMessage); virtual id_First + oqid_Cancel;
  164.   end;
  165.  
  166.   TClipping = object(TDialog)
  167.     OldClipping: integer;
  168.     procedure SetupWindow; virtual;
  169.     procedure RadioSet(MessageID: integer);
  170.     procedure SetChar(var Msg: TMessage); virtual id_First + cpid_Char;
  171.     procedure SetDefault(var Msg: TMessage); virtual id_First + cpid_Default;
  172.     procedure SetStroke(var Msg: TMessage); virtual id_First + cpid_Stroke;
  173.     procedure OKEnd(var Msg: TMessage); virtual id_First + cpid_OK;
  174.     procedure CancelEnd(var Msg: TMessage); virtual id_First + cpid_Cancel;
  175.   end;
  176.  
  177.   TPitch = object(TDialog)
  178.     OldPitch: integer;
  179.     procedure SetupWindow; virtual;
  180.     procedure RadioSet(MessageID: integer);
  181.     procedure SetDefault(var Msg: TMessage); virtual id_First + fpid_Default;
  182.     procedure SetFixed(var Msg: TMessage); virtual id_First + fpid_Fixed;
  183.     procedure SetVariable(var Msg: TMessage); virtual id_First + fpid_Variable;
  184.     procedure OKEnd(var Msg: TMessage); virtual id_First + fpid_OK;
  185.     procedure CancelEnd(var Msg: TMessage); virtual id_First + fpid_Cancel;
  186.   end;
  187.  
  188.   TFamily = object(TDialog)
  189.     OldFamily: integer;
  190.     procedure SetupWindow; virtual;
  191.     procedure RadioSet(MessageID: integer);
  192.     procedure SetDecorate(var Msg: TMessage); virtual id_First + ffid_Decorate;
  193.     procedure SetDontCare(var Msg: TMessage); virtual id_First + ffid_DontCare;
  194.     procedure SetModern(var Msg: TMessage); virtual id_First + ffid_Modern;
  195.     procedure SetRoman(var Msg: TMessage); virtual id_First + ffid_Roman;
  196.     procedure SetScript(var Msg: TMessage); virtual id_First + ffid_Script;
  197.     procedure SetSwiss(var Msg: TMessage); virtual id_First + ffid_Swiss;
  198.     procedure OKEnd(var Msg: TMessage); virtual id_First + ffid_OK;
  199.     procedure CancelEnd(var Msg: TMessage); virtual id_First + ffid_Cancel;
  200.   end;
  201.  
  202.   TWeight = object(TDialog)
  203.     OldWeight: integer;
  204.     procedure SetupWindow; virtual;
  205.     procedure RadioSet(MessageID: integer);
  206.     procedure SetDontCare(var Msg: TMessage); virtual id_First + fwid_DontCare;
  207.     procedure SetThin(var Msg: TMessage); virtual id_First + fwid_Thin;
  208.     procedure SetXtraLite(var Msg: TMessage); virtual id_First + fwid_XtraLite;
  209.     procedure SetLight(var Msg: TMessage); virtual id_First + fwid_Light;
  210.     procedure SetNormal(var Msg: TMessage); virtual id_First + fwid_Normal;
  211.     procedure SetMedium(var Msg: TMessage); virtual id_First + fwid_Medium;
  212.     procedure SetSemiBold(var Msg: TMessage); virtual id_First + fwid_SemiBold;
  213.     procedure SetBold(var Msg: TMessage); virtual id_First + fwid_Bold;
  214.     procedure SetXtraBold(var Msg: TMessage); virtual id_First + fwid_XtraBold;
  215.     procedure SetHeavy(var Msg: TMessage); virtual id_First + fwid_Heavy;
  216.     procedure OKEnd(var Msg: TMessage); virtual id_First + fwid_OK;
  217.     procedure CancelEnd(var Msg: TMessage); virtual id_First + fwid_Cancel;
  218.   end;
  219.  
  220.   MyApp = object(TApplication)
  221.     procedure InitMainWindow; virtual;
  222.   end;
  223.  
  224. (*:::::::::::::::::::::::::Global Variables::::::::::::::::::::::::::::*)
  225.  
  226. var LogFont : TLogFont;
  227.     VPitch: Integer;
  228.     VFamily: Integer;
  229.  
  230. (*::::::::::::::::::::::::: TAbout Procedures::::::::::::::::::::::::::*)
  231.  
  232. procedure TAbout.SetupWindow;
  233. var TheDC: HDC;
  234.     TheIcon: HIcon;
  235.     Test: Boolean;
  236. begin
  237.   TDialog.SetupWindow;
  238.   TheIcon := LoadIcon(HInstance, 'FMU_ICON' );
  239.   TheDC := GetDC( HWindow );
  240.   test := DrawIcon(TheDC, 30, 30, TheIcon);
  241.   ReleaseDC( HWindow, TheDC );
  242. end;
  243.  
  244. procedure TAbout.OKEnd(var Msg: TMessage);
  245. begin
  246.   OK(Msg);
  247. end;
  248.  
  249. (*::::::::::::::::::::::::TCharSet Procedures::::::::::::::::::::::::::*)
  250.  
  251. procedure TCharSet.SetupWindow;
  252. Begin
  253.   TDialog.SetupWindow;
  254.   OldCharSet := LogFont.lfCharSet;
  255.   case OldCharSet of
  256.     ANSI_CharSet:   CheckRadioButton(HWindow, csid_ANSI, csid_Symbol, csid_ANSI);
  257.     OEM_CharSet:    CheckRadioButton(HWindow, csid_ANSI, csid_Symbol, csid_OEM);
  258.     Symbol_CharSet: CheckRadioButton(HWindow, csid_ANSI, csid_Symbol, csid_Symbol);
  259.   end;
  260. End;
  261.  
  262. procedure TCharSet.RadioSet(MessageID: integer);
  263. Begin
  264.   CheckRadioButton(HWindow, csid_ANSI, csid_Symbol, MessageID);
  265.   case MessageID of
  266.     csid_ANSI     : LogFont.lfCharSet := ANSI_CharSet;
  267.     csid_OEM      : LogFont.lfCharSet := OEM_CharSet;
  268.     csid_Symbol   : LogFont.lfCharSet := Symbol_CharSet;
  269.   end;
  270. End;
  271.  
  272. procedure TCharSet.SetANSI(var Msg: TMessage);   Begin  RadioSet(csid_ANSI); End;
  273. procedure TCharSet.SetOEM(var Msg: TMessage);    Begin  RadioSet(csid_OEM); End;
  274. procedure TCharSet.SetSymbol(var Msg: TMessage); Begin  RadioSet(csid_Symbol); End;
  275. procedure TCharSet.OKEnd(var Msg: TMessage);     Begin  OK(Msg); End;
  276.  
  277. procedure TCharSet.CancelEnd(var Msg: TMessage);
  278. Begin
  279.   LogFont.lfCharSet := OldCharSet;
  280.   Cancel(Msg);
  281. End;
  282.  
  283. (*::::::::::::::::::::::::TOutput Procedures::::::::::::::::::::::::::*)
  284.  
  285. procedure TOutput.SetupWindow;
  286. Begin
  287.   TDialog.SetupWindow;
  288.   OldOutput := LogFont.lfOutPrecision;
  289.   case OldOutput of
  290.     Out_Character_Precis: CheckRadioButton(HWindow, opid_Char, opid_Stroke, opid_Char);
  291.     Out_Default_Precis:   CheckRadioButton(HWindow, opid_Char, opid_Stroke, opid_Default);
  292.     Out_String_Precis:    CheckRadioButton(HWindow, opid_Char, opid_Stroke, opid_String);
  293.     Out_Stroke_Precis:    CheckRadioButton(HWindow, opid_Char, opid_Stroke, opid_Stroke);
  294.   end;
  295. End;
  296.  
  297. procedure TOutput.RadioSet(MessageID: integer);
  298. Begin
  299.   CheckRadioButton(HWindow, opid_Char, opid_Stroke, MessageID);
  300.   case MessageID of
  301.     opid_Char     : LogFont.lfOutPrecision := Out_Character_Precis;
  302.     opid_Default  : LogFont.lfOutPrecision := Out_Default_Precis;
  303.     opid_String   : LogFont.lfOutPrecision := Out_String_Precis;
  304.     opid_Stroke   : LogFont.lfOutPrecision := Out_Stroke_Precis;
  305.   end;
  306. End;
  307.  
  308. procedure TOutput.SetChar(var Msg: TMessage);    Begin  RadioSet(opid_Char);    End;
  309. procedure TOutput.SetDefault(var Msg: TMessage); Begin  RadioSet(opid_Default); End;
  310. procedure TOutput.SetString(var Msg: TMessage);  Begin  RadioSet(opid_String);  End;
  311. procedure TOutput.SetStroke(var Msg: TMessage);  Begin  RadioSet(opid_Stroke);  End;
  312. procedure TOutput.OKEnd(var Msg: TMessage);      Begin  OK(Msg);                End;
  313.  
  314. procedure TOutput.CancelEnd(var Msg: TMessage);
  315. Begin
  316.   LogFont.lfOutPrecision := OldOutput;
  317.   Cancel(Msg);
  318. End;
  319.  
  320. (*::::::::::::::::::::::::TQuality Procedures::::::::::::::::::::::::::*)
  321.  
  322. procedure TQuality.SetupWindow;
  323. Begin
  324.   TDialog.SetupWindow;
  325.   OldQuality := LogFont.lfQuality;
  326.   case OldQuality of
  327.     Default_Quality: CheckRadioButton(HWindow, oqid_Default, oqid_Proof, oqid_Default);
  328.     Draft_Quality:   CheckRadioButton(HWindow, oqid_Default, oqid_Proof, oqid_Draft);
  329.     Proof_Quality:   CheckRadioButton(HWindow, oqid_Default, oqid_Proof, oqid_Proof);
  330.   end;
  331. End;
  332.  
  333. procedure TQuality.RadioSet(MessageID: integer);
  334. Begin
  335.   CheckRadioButton(HWindow, oqid_Default, oqid_Proof, MessageID);
  336.   case MessageID of
  337.     oqid_Default  : LogFont.lfQuality := Default_Quality;
  338.     oqid_Draft    : LogFont.lfQuality := Draft_Quality;
  339.     oqid_Proof    : LogFont.lfQuality := Proof_Quality;
  340.   end;
  341. End;
  342.  
  343. procedure TQuality.SetDefault(var Msg: TMessage); Begin  RadioSet(oqid_Default); End;
  344. procedure TQuality.SetDraft(var Msg: TMessage);   Begin  RadioSet(oqid_Draft);   End;
  345. procedure TQuality.SetProof(var Msg: TMessage);   Begin  RadioSet(oqid_Proof);   End;
  346. procedure TQuality.OKEnd(var Msg: TMessage);      Begin  OK(Msg);                End;
  347.  
  348. procedure TQuality.CancelEnd(var Msg: TMessage);
  349. Begin
  350.   LogFont.lfQuality := OldQuality;
  351.   Cancel(Msg);
  352. End;
  353.  
  354. (*::::::::::::::::::::::::TClipping Procedures::::::::::::::::::::::::::*)
  355.  
  356. procedure TClipping.SetupWindow;
  357. Begin
  358.   TDialog.SetupWindow;
  359.   OldClipping := LogFont.lfClipPrecision;
  360.   case OldClipping of
  361.     Clip_Character_Precis: CheckRadioButton(HWindow, cpid_Char, cpid_Stroke, cpid_Char);
  362.     Clip_Default_Precis:   CheckRadioButton(HWindow, cpid_Char, cpid_Stroke, cpid_Default);
  363.     Clip_Stroke_Precis:    CheckRadioButton(HWindow, cpid_Char, cpid_Stroke, cpid_Stroke);
  364.   end;
  365. End;
  366.  
  367. procedure TClipping.RadioSet(MessageID: integer);
  368. Begin
  369.   CheckRadioButton(HWindow, cpid_Char, cpid_Stroke, MessageID);
  370.   case MessageID of
  371.     cpid_Char     : LogFont.lfClipPrecision := Clip_Character_Precis;
  372.     cpid_Default  : LogFont.lfClipPrecision := Clip_Default_Precis;
  373.     cpid_Stroke   : LogFont.lfClipPrecision := Clip_Stroke_Precis;
  374.   end;
  375. End;
  376.  
  377. procedure TClipping.SetChar(var Msg: TMessage);    Begin  RadioSet(cpid_Char);    End;
  378. procedure TClipping.SetDefault(var Msg: TMessage); Begin  RadioSet(cpid_Default); End;
  379. procedure TClipping.SetStroke(var Msg: TMessage);  Begin  RadioSet(cpid_Stroke);  End;
  380. procedure TClipping.OKEnd(var Msg: TMessage);      Begin  OK(Msg);                End;
  381.  
  382. procedure TClipping.CancelEnd(var Msg: TMessage);
  383. Begin
  384.   LogFont.lfClipPrecision := OldClipping;
  385.   Cancel(Msg);
  386. End;
  387.  
  388. (*::::::::::::::::::::::::TPitch Procedures::::::::::::::::::::::::::*)
  389.  
  390. procedure TPitch.SetupWindow;
  391. Begin
  392.   TDialog.SetupWindow;
  393.   OldPitch := VPitch;
  394.   case OldPitch of
  395.     Default_Pitch:  CheckRadioButton(HWindow, fpid_Default, fpid_Variable, fpid_Default);
  396.     Fixed_Pitch:    CheckRadioButton(HWindow, fpid_Default, fpid_Variable, fpid_Fixed);
  397.     Variable_Pitch: CheckRadioButton(HWindow, fpid_Default, fpid_Variable, fpid_Variable);
  398.   end;
  399. End;
  400.  
  401. procedure TPitch.RadioSet(MessageID: integer);
  402. Begin
  403.   CheckRadioButton(HWindow, fpid_Default, fpid_Variable, MessageID);
  404.   case MessageID of
  405.     fpid_Default  : VPitch := Default_Pitch;
  406.     fpid_Fixed    : VPitch := Fixed_Pitch;
  407.     fpid_Variable : VPitch := Variable_Pitch;
  408.   end;
  409. End;
  410.  
  411. procedure TPitch.SetDefault(var Msg: TMessage);  Begin  RadioSet(fpid_Default);  End;
  412. procedure TPitch.SetFixed(var Msg: TMessage);    Begin  RadioSet(fpid_Fixed);    End;
  413. procedure TPitch.SetVariable(var Msg: TMessage); Begin  RadioSet(fpid_Variable); End;
  414.  
  415. procedure TPitch.OKEnd(var Msg: TMessage);
  416. Begin
  417.   LogFont.lfPitchAndFamily := VFamily or VPitch;
  418.   OK(Msg);
  419. End;
  420.  
  421. procedure TPitch.CancelEnd(var Msg: TMessage);
  422. Begin
  423.   VPitch := OldPitch;
  424.   Cancel(Msg);
  425. End;
  426.  
  427. (*::::::::::::::::::::::::TFamily Procedures::::::::::::::::::::::::::*)
  428.  
  429. procedure TFamily.SetupWindow;
  430. Begin
  431.   TDialog.SetupWindow;
  432.   OldFamily := VFamily;
  433.   case OldFamily of
  434.     ff_Decorative: CheckRadioButton(HWindow, ffid_Decorate, ffid_Swiss, ffid_Decorate);
  435.     ff_DontCare:   CheckRadioButton(HWindow, ffid_Decorate, ffid_Swiss, ffid_DontCare);
  436.     ff_Modern:     CheckRadioButton(HWindow, ffid_Decorate, ffid_Swiss, ffid_Modern);
  437.     ff_Roman:      CheckRadioButton(HWindow, ffid_Decorate, ffid_Swiss, ffid_Roman);
  438.     ff_Script:     CheckRadioButton(HWindow, ffid_Decorate, ffid_Swiss, ffid_Script);
  439.     ff_Swiss:      CheckRadioButton(HWindow, ffid_Decorate, ffid_Swiss, ffid_Swiss);
  440.   end;
  441. End;
  442.  
  443. procedure TFamily.RadioSet(MessageID: integer);
  444. Begin
  445.   CheckRadioButton(HWindow, ffid_Decorate, ffid_Swiss, MessageID);
  446.   case MessageID of
  447.     ffid_Decorate : VFamily := ff_Decorative;
  448.     ffid_DontCare : VFamily := ff_DontCare;
  449.     ffid_Modern   : VFamily := ff_Modern;
  450.     ffid_Roman    : VFamily := ff_Roman;
  451.     ffid_Script   : VFamily := ff_Script;
  452.     ffid_Swiss    : VFamily := ff_Swiss;
  453.   end;
  454. End;
  455.  
  456. procedure TFamily.SetDecorate(var Msg: TMessage); Begin RadioSet(ffid_Decorate); End;
  457. procedure TFamily.SetDontCare(var Msg: TMessage); Begin RadioSet(ffid_DontCare); End;
  458. procedure TFamily.SetModern(var Msg: TMessage);   Begin RadioSet(ffid_Modern);   End;
  459. procedure TFamily.SetRoman(var Msg: TMessage);    Begin RadioSet(ffid_Roman);    End;
  460. procedure TFamily.SetScript(var Msg: TMessage);   Begin RadioSet(ffid_Script);   End;
  461. procedure TFamily.SetSwiss(var Msg: TMessage);    Begin RadioSet(ffid_Swiss);    End;
  462.  
  463. procedure TFamily.OKEnd(var Msg: TMessage);
  464. Begin
  465.   LogFont.lfPitchAndFamily := VFamily or VPitch;
  466.   OK(Msg);
  467. End;
  468.  
  469. procedure TFamily.CancelEnd(var Msg: TMessage);
  470. Begin
  471.   VFamily := OldFamily;
  472.   Cancel(Msg);
  473. End;
  474.  
  475. (*::::::::::::::::::::::::TWeight Procedures::::::::::::::::::::::::::*)
  476.  
  477. procedure TWeight.SetupWindow;
  478. Begin
  479.   TDialog.SetupWindow;
  480.   OldWeight := LogFont.lfWeight;
  481.   case OldWeight of
  482.     fw_DontCare : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_DontCare);
  483.     fw_Thin     : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_Thin);
  484.     fw_ExtraLight : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_XtraLite);
  485.     fw_Light    : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_Light);
  486.     fw_Normal   : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_Normal);
  487.     fw_Medium   : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_Medium);
  488.     fw_SemiBold : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_SemiBold);
  489.     fw_Bold     : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_Bold);
  490.     fw_ExtraBold : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_XtraBold);
  491.     fw_Heavy    : CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, fwid_Heavy);
  492.   end;
  493. End;
  494.  
  495. procedure TWeight.RadioSet(MessageID: integer);
  496. Begin
  497.   CheckRadioButton(HWindow, fwid_DontCare, fwid_Heavy, MessageID);
  498.   case MessageID of
  499.     fwid_DontCare : LogFont.lfWeight := fw_DontCare;
  500.     fwid_Thin     : LogFont.lfWeight := fw_Thin;
  501.     fwid_XtraLite : LogFont.lfWeight := fw_ExtraLight;
  502.     fwid_Light    : LogFont.lfWeight := fw_Light;
  503.     fwid_Normal   : LogFont.lfWeight := fw_Normal;
  504.     fwid_Medium   : LogFont.lfWeight := fw_Medium;
  505.     fwid_SemiBold : LogFont.lfWeight := fw_SemiBold;
  506.     fwid_Bold     : LogFont.lfWeight := fw_Bold;
  507.     fwid_XtraBold : LogFont.lfWeight := fw_ExtraBold;
  508.     fwid_Heavy    : LogFont.lfWeight := fw_Heavy;
  509.   end;
  510. End;
  511.  
  512. procedure TWeight.SetDontCare(var Msg: TMessage); Begin RadioSet(fwid_DontCare); End;
  513. procedure TWeight.SetThin(var Msg: TMessage);     Begin RadioSet(fwid_Thin); End;
  514. procedure TWeight.SetXtraLite(var Msg: TMessage); Begin RadioSet(fwid_XtraLite); End;
  515. procedure TWeight.SetLight(var Msg: TMessage);    Begin RadioSet(fwid_Light); End;
  516. procedure TWeight.SetNormal(var Msg: TMessage);   Begin RadioSet(fwid_Normal); End;
  517. procedure TWeight.SetMedium(var Msg: TMessage);   Begin RadioSet(fwid_Medium); End;
  518. procedure TWeight.SetSemiBold(var Msg: TMessage); Begin RadioSet(fwid_SemiBold); End;
  519. procedure TWeight.SetBold(var Msg: TMessage);     Begin RadioSet(fwid_Bold); End;
  520. procedure TWeight.SetXtraBold(var Msg: TMessage); Begin RadioSet(fwid_XtraBold); End;
  521. procedure TWeight.SetHeavy(var Msg: TMessage);    Begin RadioSet(fwid_Heavy); End;
  522. procedure TWeight.OKEnd(var Msg: TMessage);       Begin OK(Msg); End;
  523.  
  524. procedure TWeight.CancelEnd(var Msg: TMessage);
  525. Begin
  526.   LogFont.lfWeight := OldWeight;
  527.   Cancel(Msg);
  528. End;
  529.  
  530. (*::::::::::::::::::::::::::TMyDlg Procedures::::::::::::::::::::::::::*)
  531.  
  532. constructor TMyDlg.Init(AParent: PWindowsObject; AName: PChar);
  533. var AsciStr: PChar;
  534.     AString: Array[0..52] of char;
  535. begin
  536.   BaseFontDimensions;
  537.   strcopy( AString, 'AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz');
  538.   AsciStr := @AString[0];
  539.   TDlgWindow.Init(AParent, AName);
  540.   EditBox.Init(@Self, id_EditBox, AsciStr, x+2, y*12-2, x*62-1, y*8+2, 0, True);
  541.   TheFont := 0;
  542.   with LogFont do begin
  543.     lfHeight := 12;
  544.     lfWidth := 12;
  545.     lfEscapement := 0;
  546.     lfOrientation := 0;
  547.     lfWeight := fw_Normal;
  548.     lfItalic := F;
  549.     lfUnderline := F;
  550.     lfStrikeOut := F;
  551.     lfCharSet := ANSI_CharSet;
  552.     lfOutPrecision := Out_Default_Precis;
  553.     lfClipPrecision := Clip_Default_Precis;
  554.     lfQuality := Default_Quality;
  555.     lfPitchAndFamily := Variable_Pitch or ff_Script;
  556.     StrPCopy(lfFaceName, 'Roman');
  557.   end;
  558.   HeightScroll.Init(@Self, id_HeightScroll, x*14, y+1,   x*20-2, y+1, True);
  559.   WidthScroll.Init(@Self, id_WidthScroll,   x*14, y*3-4, x*20-2, y+1, True);
  560.   EscScroll.Init(@Self, id_EscScroll,       x*14, y*5-6, x*20-2, y+1, True);
  561.   OrientScroll.Init(@Self, id_OrientScroll, x*14, y*6+8, x*20-2, y+1, True);
  562.   WeightScroll.Init(@Self, id_WeightScroll, x*14, y*8+6, x*20-2, y+1, True);
  563.   HeightScroll.SetPosition(LogFont.lfHeight);
  564.   WidthScroll.SetPosition(LogFont.lfWidth);
  565.   EscScroll.SetPosition(LogFont.lfEscapement);
  566.   OrientScroll.SetPosition(LogFont.lfOrientation);
  567.   WeightScroll.SetPosition(LogFont.lfWeight);
  568. end;
  569.  
  570. procedure TMyDlg.BaseFontDimensions;
  571. var Convert: LongInt;
  572. begin
  573.   Convert := GetDialogBaseUnits;
  574.   x := Convert;
  575.   y := Convert shr 16;
  576. end;
  577.  
  578. function TMyDlg.GetClassName: PChar;
  579. begin
  580.   GetClassName := 'FMU';
  581. end;
  582.  
  583. procedure TMyDlg.GetWindowClass(var WndClass: TWndClass);
  584. begin
  585.   TDlgWindow.GetWindowClass(WndClass);
  586.   WndClass.hIcon := LoadIcon(HInstance, 'FMU_ICON');
  587. end;
  588.  
  589. procedure TMyDlg.SetupWindow;
  590. var SysMenu: HMenu;
  591.     Msg: TMessage;
  592. Begin
  593.   TDlgWindow.SetupWindow;
  594.   SysMenu := GetSystemMenu(HWindow, False);
  595.   AppendMenu(SysMenu, mf_Enabled, id_AboutFMU, 'About FMU' );
  596.   DoStuff;
  597. End;
  598.  
  599. procedure TMyDlg.DefWndProc(var Msg: TMessage);
  600. var AboutDlg: TAbout;
  601. begin
  602.   if (Msg.Message = WM_SysCommand) and (Msg.WParam = id_AboutFMU) then begin
  603.     AboutDlg.Init( @self.HWindow, 'ABOUT FMU' );
  604.     AboutDlg.Execute;
  605.     AboutDlg.Done;
  606.   end;
  607.   TDlgWindow.DefWndProc(Msg);
  608. end;
  609.  
  610. procedure TMyDlg.HeightScroller(var Msg: Tmessage);
  611. Begin
  612.   LogFont.lfHeight := HeightScroll.GetPosition;
  613.   DoStuff;
  614. End;
  615.  
  616. procedure TMyDlg.WidthScroller(var Msg: Tmessage);
  617. Begin
  618.   LogFont.lfWidth := WidthScroll.GetPosition;
  619.   DoStuff;
  620. End;
  621.  
  622. procedure TMyDlg.EscScroller(var Msg: Tmessage);
  623. Begin
  624.   LogFont.lfEscapement := EscScroll.GetPosition * 36;
  625.   DoStuff;
  626. End;
  627.  
  628. procedure TMyDlg.OrientScroller(var Msg: Tmessage);
  629. Begin
  630.   LogFont.lfOrientation := OrientScroll.GetPosition * 36;
  631.   DoStuff;
  632. End;
  633.  
  634. procedure TMyDlg.WeightScroller(var Msg: Tmessage);
  635. Begin
  636.   LogFont.lfWeight := WeightScroll.GetPosition * 10;
  637.   DoStuff;
  638. End;
  639.  
  640. procedure TMyDlg.Italicized(var Msg: TMessage);
  641. Begin
  642.   if( LogFont.lfItalic = F ) then begin
  643.     LogFont.lfItalic := T;
  644.     CheckDlgButton(HWindow, id_Italicized, cb_Checked);
  645.     end
  646.   else begin
  647.     LogFont.lfItalic := F;
  648.     CheckDlgButton(HWindow, id_Italicized, cb_Removed);
  649.   end;
  650.   DoStuff;
  651. End;
  652.  
  653. procedure TMyDlg.Underlined(var Msg: TMessage);
  654. Begin
  655.   if( LogFont.lfUnderline = F ) then begin
  656.     LogFont.lfUnderline := T;
  657.     CheckDlgButton(HWindow, id_Underlined, cb_Checked);
  658.     end
  659.   else begin
  660.     LogFont.lfUnderline := F;
  661.     CheckDlgButton(HWindow, id_Underlined, cb_Removed);
  662.   end;
  663.   DoStuff;
  664. End;
  665.  
  666. procedure TMyDlg.StrikeOut(var Msg: TMessage);
  667. Begin
  668.   if( LogFont.lfStrikeOut = F ) then begin
  669.     LogFont.lfStrikeOut := T;
  670.     CheckDlgButton(HWindow, id_StrikeOut, cb_Checked);
  671.     end
  672.   else begin
  673.     LogFont.lfStrikeOut := F;
  674.     CheckDlgButton(HWindow, id_StrikeOut, cb_Removed);
  675.   end;
  676.   DoStuff;
  677. End;
  678.  
  679. procedure TMyDlg.CharSet(var Msg: TMessage);
  680. var CharSetDlg: TCharSet;
  681. Begin
  682.   CharSetDlg.Init( @self.HWindow, 'CHARACTER SET');
  683.   CharSetDlg.Execute;
  684.   CharSetDlg.Done;
  685.   DoStuff;
  686. End;
  687.  
  688. procedure TMyDlg.Output(var Msg: TMessage);
  689. var OutputDlg: TOutput;
  690. Begin
  691.   OutputDlg.Init( @self.HWindow, 'OUTPUT');
  692.   OutputDlg.Execute;
  693.   OutputDlg.Done;
  694.   DoStuff;
  695. End;
  696.  
  697. procedure TMyDlg.Quality(var Msg: TMessage);
  698. var QualityDlg: TQuality;
  699. Begin
  700.   QualityDlg.Init( @self.HWindow, 'OUTPUT QUALITY');
  701.   QualityDlg.Execute;
  702.   QualityDlg.Done;
  703.   DoStuff;
  704. End;
  705.  
  706. procedure TMyDlg.Clipping(var Msg: TMessage);
  707. var ClippingDlg: TClipping;
  708. Begin
  709.   ClippingDlg.Init( @self.HWindow, 'CLIPPING');
  710.   ClippingDlg.Execute;
  711.   ClippingDlg.Done;
  712.   DoStuff;
  713. End;
  714.  
  715. procedure TMyDlg.Pitch(var Msg: TMessage);
  716. var PitchDlg: TPitch;
  717. Begin
  718.   PitchDlg.Init( @self.HWindow, 'FONT PITCH');
  719.   PitchDlg.Execute;
  720.   PitchDlg.Done;
  721.   DoStuff;
  722. End;
  723.  
  724. procedure TMyDlg.Family(var Msg: TMessage);
  725. var FamilyDlg: TFamily;
  726. Begin
  727.   FamilyDlg.Init( @self.HWindow, 'FAMILIES');
  728.   FamilyDlg.Execute;
  729.   FamilyDlg.Done;
  730.   DoStuff;
  731. End;
  732.  
  733. procedure TMyDlg.Weight(var Msg: TMessage);
  734. var WeightDlg: TWeight;
  735. Begin
  736.   WeightDlg.Init( @self.HWindow, 'WEIGHTS');
  737.   WeightDlg.Execute;
  738.   WeightDlg.Done;
  739.   WeightScroll.SetPosition(LogFont.lfWeight div 10);
  740.   DoStuff;
  741. End;
  742.  
  743. procedure TMyDlg.DoStuff;
  744. var TheDC: HDC;
  745.     TheIcon: hIcon;
  746. begin
  747.   if TheFont > 0 then DeleteObject(TheFont);
  748.   TheFont := CreateFontIndirect(LogFont);
  749.   TheDC := GetDC( EditBox.HWindow );
  750.   SelectObject(TheDC, TheFont );
  751.   SendMessage( EditBox.HWindow, wm_SetFont, TheFont, 0);
  752.   GetTextFace(TheDC, 20, @TextFace[0]);
  753.   StrLCat( TextFace, '                    ', 20 );
  754.   ReleaseDC( EditBox.HWindow, TheDC );
  755.   TheDC := GetDC( HWindow );
  756.   TextOut(TheDC, x*42-1, y*2+8, @TextFace[0], 20);
  757.   ReleaseDC( HWindow, TheDC );
  758. end;
  759.  
  760. procedure TMyDlg.CleanUp;
  761. begin
  762.   HeightScroll.Done;
  763.   WidthScroll.Done;
  764.   EscScroll.Done;
  765.   OrientScroll.Done;
  766.   WeightScroll.Done;
  767.   EditBox.Done;
  768. end;
  769.  
  770. destructor TMyDlg.Done;
  771. begin
  772.   CleanUp;
  773.   TDlgWindow.Done;
  774. end;
  775.  
  776. (*:::::::::::::::::::::::::::MyApp Procedures::::::::::::::::::::::::::*)
  777.  
  778. procedure MyApp.InitMainWindow;
  779. begin
  780.   MainWindow := New(PMyDlg, Init(nil, 'FONT WORK'));
  781. end;
  782.  
  783. (*:::::::::::::::::::::::::::Main Program Body:::::::::::::::::::::::::*)
  784.  
  785. var
  786.   MainProc: MyApp;
  787.  
  788. begin
  789.   MainProc.Init('FONT WORK');
  790.   MainProc.Run;
  791.   MainProc.Done;
  792. end.